home *** CD-ROM | disk | FTP | other *** search
/ Language/OS - Multiplatform Resource Library / LANGUAGE OS.iso / lisp / elk-2_0.lha / elk-2.0 / src / char.c < prev    next >
C/C++ Source or Header  |  1992-03-17  |  3KB  |  114 lines
  1. #include <ctype.h>
  2.  
  3. #include "scheme.h"
  4.  
  5. Object Make_Char (c) register c; {
  6.     Object ch;
  7.  
  8.     SET(ch, T_Character, (unsigned char)c);
  9.     return ch;
  10. }
  11.  
  12. Object P_Charp (c) Object c; {
  13.     return TYPE(c) == T_Character ? True : False;
  14. }
  15.  
  16. Object P_Char_To_Integer (c) Object c; {
  17.     Check_Type (c, T_Character);
  18.     return Make_Integer (CHAR(c));
  19. }
  20.  
  21. Object P_Integer_To_Char (n) Object n; {
  22.     register i;
  23.  
  24.     if ((i = Get_Integer (n)) < 0 || i > 255)
  25.     Range_Error (n);
  26.     return Make_Char (i);
  27. }
  28.  
  29. Object P_Char_Upper_Case (c) Object c; {
  30.     Check_Type (c, T_Character);
  31.     return isupper (CHAR(c)) ? True : False;
  32. }
  33.  
  34. Object P_Char_Lower_Case (c) Object c; {
  35.     Check_Type (c, T_Character);
  36.     return islower (CHAR(c)) ? True : False;
  37. }
  38.  
  39. Object P_Char_Alphabetic (c) Object c; {
  40.     Check_Type (c, T_Character);
  41.     return isalpha (CHAR(c)) ? True : False;
  42. }
  43.  
  44. Object P_Char_Numeric (c) Object c; {
  45.     Check_Type (c, T_Character);
  46.     return isdigit (CHAR(c)) ? True : False;
  47. }
  48.  
  49. Object P_Char_Whitespace (c) Object c; {
  50.     register x;
  51.  
  52.     Check_Type (c, T_Character);
  53.     x = CHAR(c);
  54.     return Whitespace (x) ? True : False;
  55. }
  56.  
  57. Object P_Char_Upcase (c) Object c; {
  58.     Check_Type (c, T_Character);
  59.     return islower (CHAR(c)) ? Make_Char (toupper (CHAR(c))) : c;
  60. }
  61.  
  62. Object P_Char_Downcase (c) Object c; {
  63.     Check_Type (c, T_Character);
  64.     return isupper (CHAR(c)) ? Make_Char (tolower (CHAR(c))) : c;
  65. }
  66.  
  67. General_Chrcmp (c1, c2, ci) Object c1, c2; register ci; {
  68.     Check_Type (c1, T_Character);
  69.     Check_Type (c2, T_Character);
  70.     if (ci)
  71.     return Char_Map[CHAR(c1)] - Char_Map[CHAR(c2)];
  72.     return CHAR(c1) - CHAR(c2);
  73. }
  74.  
  75. Object P_Chr_Eq (c1, c2) Object c1, c2; {
  76.     return General_Chrcmp (c1, c2, 0) ? False : True;
  77. }
  78.  
  79. Object P_Chr_Less (c1, c2) Object c1, c2; {
  80.     return General_Chrcmp (c1, c2, 0) < 0 ? True : False;
  81. }
  82.  
  83. Object P_Chr_Greater (c1, c2) Object c1, c2; {
  84.     return General_Chrcmp (c1, c2, 0) > 0 ? True : False;
  85. }
  86.  
  87. Object P_Chr_Eq_Less (c1, c2) Object c1, c2; {
  88.     return General_Chrcmp (c1, c2, 0) <= 0 ? True : False;
  89. }
  90.  
  91. Object P_Chr_Eq_Greater (c1, c2) Object c1, c2; {
  92.     return General_Chrcmp (c1, c2, 0) >= 0 ? True : False;
  93. }
  94.  
  95. Object P_Chr_CI_Eq (c1, c2) Object c1, c2; {
  96.     return General_Chrcmp (c1, c2, 1) ? False : True;
  97. }
  98.  
  99. Object P_Chr_CI_Less (c1, c2) Object c1, c2; {
  100.     return General_Chrcmp (c1, c2, 1) < 0 ? True : False;
  101. }
  102.  
  103. Object P_Chr_CI_Greater (c1, c2) Object c1, c2; {
  104.     return General_Chrcmp (c1, c2, 1) > 0 ? True : False;
  105. }
  106.  
  107. Object P_Chr_CI_Eq_Less (c1, c2) Object c1, c2; {
  108.     return General_Chrcmp (c1, c2, 1) <= 0 ? True : False;
  109. }
  110.  
  111. Object P_Chr_CI_Eq_Greater (c1, c2) Object c1, c2; {
  112.     return General_Chrcmp (c1, c2, 1) >= 0 ? True : False;
  113. }
  114.